home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 11 / Amiga Format AFCD11 (Feb 1997, Issue 95).iso / -seriously_amiga- / commercial / ppaint7demo / rexx / catalog.pprx < prev    next >
Text File  |  1997-01-31  |  23KB  |  811 lines
  1. /* Personal Paint Amiga Rexx script - Copyright © 1996 Cloanto Italia srl */
  2.  
  3. /* $VER: Catalog.pprx 1.1 */
  4.  
  5. /** ENG
  6.  This script creates reference catalogs ("thumbnails") for the images
  7.  contained in the specified directory.
  8.  
  9.  The first requester can be used to select the catalog background
  10.  (white, gray, or black), the number of thumbnail columns (i.e. images
  11.  per row) and the temporary file directory used by the script. It is also
  12.  possible to decide whether an optimized palette should be generated for
  13.  each catalog (based on thumbnail colors) or not (the palette of the
  14.  current environment is used). The "Test Mode" option quickly shows
  15.  a sample catalog preview based on the current settings.
  16.  
  17.  The catalog format is based on the current image format (width, height,
  18.  aspect ratio and number of colors). This also affects the number of
  19.  catalog files generated.
  20.  
  21.  If not in test mode, two file requesters follow: the first one can be used
  22.  to select the source directory, the second one to select the destination
  23.  directory (where the catalog files will be saved), the root of the file
  24.  name and the file format/options. If the base name contains one or more
  25.  consecutive "0" characters, they will be used and progressively replaced
  26.  to store the catalog number (e.g. "Cat_000.pic" becomes "Cat_001.pic",
  27.  "Cat_002.pic", etc.).
  28.  
  29.  If a catalog file (matching the specified base name) already exists in
  30.  the destination directory, a message asks for confirmation before deleting
  31.  the old files.
  32.  
  33.  Several program settings affect the quality of the catalog images
  34.  generated by this script. These settings are: Color Reduction, Dithering,
  35.  Color Average Resize. For best-quality results, the
  36.  Floyd-Steinberg/Best Quality dithering should be selected, the
  37.  Color Average Resize option should be activated and an appropriate image
  38.  format should be used (the higher the number of colors, the better):
  39.  this is likely to slow down the generation of the catalog, but greatly
  40.  enhances the quality of the thumbnail catalogs.
  41. */
  42.  
  43. /** DEU
  44.  Dieses Skript ermöglicht die Erstellung eines Bilderkatalogs mit
  45.  verkleinerten Abbildungen der in einem Verzeichnis enthaltenen
  46.  Grafiken (sog. "Thumbnails").
  47.  
  48.  Im ersten Dialogfenster lassen sich Elemente wie der Seitenhintergrund
  49.  (wahlweise Weiß, Grau oder Schwarz), Spaltenanzahl (d.h.
  50.  die Anzahl der Bilder pro Zeile) und das temporäre Dateiverzeichnis für
  51.  das Skript festlegen. Es besteht darüber hinaus auch die Möglichkeit,
  52.  für jeden Katalog eine (auf der Palette der Kleingrafiken
  53.  basierende) Palette generieren zu lassen. Wird dies nicht gewünscht,
  54.  verwendet das Skript die Palette der aktuellen Arbeitsumgebung.
  55.  Mit Hilfe der Option "Testmodus" läßt sich eine
  56.  Katalogvorschau auf der Grundlage der aktuellen Einstellungen anzeigen.
  57.  
  58.  Das Format des Bilderkatalogs basiert grundsätzlich auf dem aktuellen
  59.  Bildformat (Breite, Höhe, Seitenverhältnis und Anzahl der Farben).
  60.  Auch die Anzahl der erzeugten Katalogdateien wird dadurch beeinflußt.
  61.  
  62.  Wenn Sie sich nicht im Testmodus befinden, werden noch zwei weitere
  63.  Dateiauswahlfenster geöffnet: Das erste dient zur Auswahl des Quell-,
  64.  und das zweite entsprechend zur Festlegung des Zielverzeichnisses
  65.  (dort werden die Katalogdateien gespeichert) sowie des Dateinamenstamms
  66.  und einiger Optionen bezüglich des Dateiformats. Wenn der Stamm des
  67.  Dateinamens eine oder mehrere aufeinanderfolgende Nullen "0" enthält,
  68.  werden diese zur Speicherung der Katalognummer verwendet. Beispiel:
  69.  "Katze_000.pic" wird zu "Katze_001.pic", "Katze_002.pic", usw.
  70.  
  71.  Ist im Zielverzeichnis bereits eine Katalogdatei mit dem angegebenen
  72.  Namensstamm vorhanden, so erscheint vor dem Überschreiben der alten
  73.  Dateien zunächst eine Sicherheitsabfrage.
  74.  
  75.  Die Qualität der für den Bilderkatalog erzeugten Kleingrafiken läßt sich
  76.  durch die folgenden Programmeinstellungen beeinflussen:
  77.  Farbreduzierung, Fehlerverteilung, "Farben mit Größe ändern".
  78.  Um ein optimales Ergebnis zu erzielen, sollte wie folgt vorgegangen
  79.  werden: Schalten Sie als Ditheringverfahren "Floyd-Steinberg" ein,
  80.  aktivieren Sie die Option "Farben mit Größe ändern", und verwenden Sie
  81.  ein geeignetes Bildformat, wobei gilt: Je mehr Farben, desto besser.
  82.  Dies erfordert zwar u. U. einen größeren Zeitaufwand, liefert aber eine
  83.  erheblich verbesserte Qualität der im Bilderkatalog enthaltenen Grafiken.
  84. */
  85.  
  86. IF ARG(1, EXISTS) THEN
  87.     PARSE ARG PPPORT
  88. ELSE
  89.     PPPORT = 'PPAINT'
  90.  
  91. IF ~SHOW('P', PPPORT) THEN DO
  92.     IF EXISTS('PPaint:PPaint') THEN DO
  93.         ADDRESS COMMAND 'Run >NIL: PPaint:PPaint'
  94.         DO 30 WHILE ~SHOW('P',PPPORT)
  95.              ADDRESS COMMAND 'Wait >NIL: 1 SEC'
  96.         END
  97.     END
  98.     ELSE DO
  99.         SAY "Personal Paint could not be loaded."
  100.         EXIT 10
  101.     END
  102. END
  103.  
  104. IF ~SHOW('P', PPPORT) THEN DO
  105.     SAY 'Personal Paint Rexx port could not be opened'
  106.     EXIT 10
  107. END
  108.  
  109. ADDRESS VALUE PPPORT
  110. OPTIONS RESULTS
  111. OPTIONS FAILAT 10000
  112.  
  113. Get 'LANG'
  114. IF RESULT = 1 THEN DO        /* Deutsch */
  115.     txt_test_tname    = 'Test.pic'
  116.     txt_title_set     = 'Katalogeinstellungen'
  117.     txt_title_font    = 'Font auswählen'
  118.     txt_title_src     = 'Quellverzeichnis auswählen'
  119.     txt_title_dst     = 'Format und Namensstamm auswählen'
  120.     txt_title_del     = 'Achtung'
  121.     txt_gad_bkg       = '_Hintergrund:'
  122.     txt_gad_bkg0      = 'Weiß'
  123.     txt_gad_bkg1      = 'Grau'
  124.     txt_gad_bkg2      = 'Schwarz'
  125.     txt_gad_colmn     = '_Spalten:'
  126.     txt_gad_recurse   = '_Unterverzeichnisse:'
  127.     txt_gad_workdir   = 'Ar_beitsverzeichnis:'
  128.     txt_gad_makeplt   = '_Palette erzeugen:'
  129.     txt_gad_test      = '_Test:'
  130.     txt_gad_yes       = '_Ja'
  131.     txt_gad_no        = '_Nein'
  132.     txt_msg_del0      = 'Sollen bestehende Alben'
  133.     txt_msg_del1      = 'gelöscht werden?'
  134.     txt_err_oldclient = 'Für dieses Skript_ist eine neuere Version_von Personal Paint erforderlich'
  135.     txt_err_resize    = 'Fehler bei Größenberechnung: '
  136.     txt_err_load      = 'Fehler beim Laden: '
  137.     txt_err_save      = 'Fehler beim Speichern: '
  138.     txt_err_creduc    = 'Fehler bei Farbreduzierung: '
  139.     txt_err_cremap    = 'Fehler bei Farbneuberechnung: '
  140. END
  141. ELSE IF RESULT = 2 THEN DO    /* Italiano */
  142.     txt_test_tname    = 'Prova.pic'
  143.     txt_title_set     = 'Parametri catalogo'
  144.     txt_title_font    = 'Selezionare font'
  145.     txt_title_src     = 'Selezionare cassetto immagini'
  146.     txt_title_dst     = 'Selezionare nome e formato catalogo'
  147.     txt_title_del     = 'Attenzione'
  148.     txt_gad_bkg       = '_Sfondo:'
  149.     txt_gad_bkg0      = 'Bianco'
  150.     txt_gad_bkg1      = 'Grigio'
  151.     txt_gad_bkg2      = 'Nero'
  152.     txt_gad_colmn     = 'C_olonne:'
  153.     txt_gad_recurse   = "Tutti i _cassetti:"
  154.     txt_gad_workdir   = 'Cassetto di la_voro:'
  155.     txt_gad_makeplt   = 'Creare _tavolozza:'
  156.     txt_gad_test      = '_Prova:'
  157.     txt_gad_yes       = '_Sì'
  158.     txt_gad_no        = '_No'
  159.     txt_msg_del0      = 'I cataloghi esistenti'
  160.     txt_msg_del1      = 'devono essere cancellati?'
  161.     txt_err_oldclient = 'Questa procedura richiede_una versione più recente_di Personal Paint'
  162.     txt_err_resize    = 'Errore nel ridimensionamento: '
  163.     txt_err_load      = 'Errore nella lettura: '
  164.     txt_err_save      = 'Errore nella scrittura: '
  165.     txt_err_creduc    = 'Errore nella riduzione colori: '
  166.     txt_err_cremap    = 'Errore nell''adattamento colori: '
  167. END
  168. ELSE DO                /* English */
  169.     txt_test_tname    = 'Test.pic'
  170.     txt_title_set     = 'Catalog Settings'
  171.     txt_title_font    = 'Select Font'
  172.     txt_title_src     = 'Select Source Directory'
  173.     txt_title_dst     = 'Select Format and Root Name'
  174.     txt_title_del     = 'Attention'
  175.     txt_gad_bkg       = '_Background:'
  176.     txt_gad_bkg0      = 'White'
  177.     txt_gad_bkg1      = 'Gray'
  178.     txt_gad_bkg2      = 'Black'
  179.     txt_gad_colmn     = 'C_olumns:'
  180.     txt_gad_recurse   = '_Subdirectories:'
  181.     txt_gad_workdir   = '_Work Directory:'
  182.     txt_gad_makeplt   = '_Make Palette:'
  183.     txt_gad_test      = '_Test:'
  184.     txt_gad_yes       = '_Yes'
  185.     txt_gad_no        = '_No'
  186.     txt_msg_del0      = 'Should existing catalog files'
  187.     txt_msg_del1      = 'be deleted?'
  188.     txt_err_oldclient = 'This script requires a newer_version of Personal Paint'
  189.     txt_err_resize    = 'Error during resize: '
  190.     txt_err_load      = 'Error during load: '
  191.     txt_err_save      = 'Error during save: '
  192.     txt_err_creduc    = 'Color reduction error: '
  193.     txt_err_cremap    = 'Color remap error: '
  194. END
  195.  
  196. Version 'REXX'
  197. IF RESULT < 7 THEN DO
  198.     RequestNotify 'PROMPT "'txt_err_oldclient'"'
  199.     EXIT 10
  200. END
  201.  
  202. srcdir      = LoadSet('SourceDir',  'PPaint:Pictures', 0)
  203. dstdir      = LoadSet('DestDir',    'PPaint:Pictures', 0)
  204. dstfile     = LoadSet('DestFile',   '000_Catalog.pic', 0)
  205. dstformat   = LoadSet('DestFormat', '', 0)
  206. fontpath    = LoadSet('FontPath',   'FONTS:', 0)
  207. fontname    = LoadSet('FontName',   'CGTriumvirate', 0)
  208. fontsize    = LoadSet('FontSize',    12, 0)
  209. fontstyle   = LoadSet('FontStyle',   's', 0)
  210. backgr      = LoadSet('Background',  0)
  211. columns     = LoadSet('Columns',     5)
  212. makepalette = LoadSet('MakePalette', 1)
  213. recurse     = LoadSet('Recurse',     0)
  214. tempdir     = LoadSet('TempDir',     'T:')
  215. test        = LoadSet('Test',        0)
  216.  
  217. max_tempdir_size = 80
  218.  
  219. FreeEnvironment 'QUERY'
  220. IF RC ~= 0 THEN
  221.     EXIT RC
  222. FreeBrush
  223. IF RC ~= 0 THEN
  224.     EXIT RC
  225.  
  226. Request '"'txt_title_set'" ' ||,
  227.             '"CYCLE = ""'txt_gad_bkg'"", 3, 'backgr', ""'txt_gad_bkg0'"", ""'txt_gad_bkg1'"", ""'txt_gad_bkg2'"" ' ||,
  228.             ' INTSTR = ""'txt_gad_colmn'"", 1, 32767, 'columns' ' ||,
  229.             ' STRING = ""'txt_gad_workdir'"", 'max_tempdir_size', ""'tempdir'"" ' ||,
  230.             ' CHECK = ""'txt_gad_makeplt'"", 'makepalette' ' ||,
  231.          ' CHECK = ""'txt_gad_recurse'"", 'recurse' ' ||,
  232.             ' CHECK = ""'txt_gad_test'"", 'test' "'
  233. IF RC ~= 0 THEN
  234.     EXIT RC
  235. backgr  = RESULT.1
  236. columns = RESULT.2
  237. tempdir = RESULT.3
  238. makepalette = RESULT.4
  239. recurse = RESULT.5
  240. test    = RESULT.6
  241.  
  242. delete_old = 0
  243.  
  244. RequestFont '"'txt_title_font'" PATH "'fontpath'" NAME "'fontname'" SIZE "'fontsize'" STYLE "'fontstyle'"'
  245. IF RC ~= 0 THEN
  246.     EXIT RC
  247. PARSE VALUE RESULT WITH '"' fontpath '" "' fontname '"' fontsize fontstyle
  248.  
  249. IF ~test THEN DO
  250.     RequestPath '"'txt_title_src'" PATH "'srcdir'"'
  251.     IF RC ~= 0 THEN
  252.         EXIT RC
  253.     PARSE VALUE RESULT WITH '"' srcdir '"'
  254.  
  255.     RequestFile '"'txt_title_dst'" PATH "'dstdir'" FILE "'dstfile'" SAVEMODE LISTFORMATS FORCE' dstformat
  256.     IF RC ~= 0 THEN
  257.         EXIT RC
  258.     PARSE VALUE RESULT WITH '"' dstdfile '"' dstformat
  259.     ppos = MAX(LASTPOS(':', dstdfile), LASTPOS('/', dstdfile)) + 1
  260.     dstdir = LEFT(dstdfile, ppos-1)
  261.     dstfile = SUBSTR(dstdfile, ppos)
  262.  
  263.     tmpfname = 'T:pprx_cat.'PRAGMA('ID')
  264.     destpattern = CatalogFName(dstfile, 0, 1)
  265.  
  266.     IF recurse THEN
  267.         ADDRESS COMMAND 'List >'tmpfname' "'srcdir'" NOHEAD PAT="'destpattern'" LFORMAT="%s%s" FILES ALL'
  268.     ELSE
  269.         ADDRESS COMMAND 'List >'tmpfname' "'dstdir'" NOHEAD PAT="'destpattern'" LFORMAT="%s%s" FILES'
  270.  
  271.     oldfiles = 0
  272.     IF OPEN('listfile', tmpfname, 'R') THEN DO
  273.         IF LENGTH(READLN('listfile')) > 0 THEN
  274.             oldfiles = 1
  275.         CALL CLOSE('listfile')
  276.     END
  277.     ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  278.     IF oldfiles THEN DO
  279.         Request '"'txt_title_del'" ' ||,
  280.                     '"TEXT = ""'txt_msg_del0'"" ' ||,
  281.                     ' TEXT = ""'txt_msg_del1'"" ' ||,
  282.                     ' ACTION = ""'txt_gad_yes'"" ACTION = ""'txt_gad_no'"" ACTION = CANCEL"'
  283.         IF RC ~= 0 THEN
  284.             EXIT RC
  285.         IF RESULT = 1 THEN
  286.             delete_old = 1
  287.     END
  288. END
  289.  
  290.  
  291.  
  292. LockGUI
  293.  
  294. CALL SaveSet('SourceDir',   srcdir)
  295. CALL SaveSet('DestDir',     dstdir)
  296. CALL SaveSet('DestFile',    dstfile)
  297. CALL SaveSet('DestFormat',  dstformat)
  298. CALL SaveSet('FontPath',    fontpath)
  299. CALL SaveSet('FontName',    fontname)
  300. CALL SaveSet('FontSize',    fontsize)
  301. CALL SaveSet('FontStyle',   fontstyle)
  302. CALL SaveSet('Background',  backgr)
  303. CALL SaveSet('Columns',     columns)
  304. CALL SaveSet('MakePalette', makepalette)
  305. CALL SaveSet('Recurse',     recurse)
  306. CALL SaveSet('TempDir',     tempdir)
  307. CALL SaveSet('Test',        test)
  308.  
  309.  
  310.  
  311. Get 'COLORS'
  312. cnum = RESULT
  313. Get 'IMAGEW'
  314. imgwidth = RESULT
  315. Get 'IMAGEH'
  316. imgheight = RESULT
  317. GetImageAttributes 'DPIX'
  318. hdpi = RESULT
  319. GetImageAttributes 'DPIY'
  320. imgratio = hdpi / RESULT
  321. Get 'CAVRESIZE'
  322. cavrg = RESULT
  323.  
  324. hgap  = TRUNC((imgwidth / columns) / 6)
  325. tilew = TRUNC((imgwidth - (hgap * (columns + 1))) / columns)
  326. hgap  = TRUNC((imgwidth - (tilew * columns)) / (columns + 1))
  327. vgap  = hgap % imgratio
  328. tileh = tilew % imgratio
  329. txgap = vgap % 10
  330.  
  331. htgap = imgwidth % 100
  332. thmbw = tilew - (htgap * 2)
  333. vtgap = htgap % imgratio
  334. thmbh = tileh - (vtgap * 2)
  335.  
  336. CALL FindPens
  337.  
  338. GetArea
  339. areasets = RESULT
  340. SetArea 'FILLSOLID'
  341. tmpfname = ''
  342. tmpdname = ''
  343.  
  344. Get 'GCLIP'
  345. saveclip = RESULT
  346. Set '"GCLIP=0"'
  347.  
  348. SIGNAL ON Break_C
  349.  
  350. IF test THEN DO
  351.     CALL InitPage
  352.     brushw = thmbw
  353.     brushh = (thmbh % 3) * 2
  354.     brushname = txt_test_tname
  355.     DO UNTIL AddTile(0)
  356.     END
  357.     CALL Break_C
  358.     EXIT 0
  359. END
  360.  
  361. dir_trail = RIGHT(tempdir, 1)
  362. IF dir_trail ~= ':' & dir_trail ~= '/' THEN
  363.     tempdir = tempdir || '/'
  364. tempdir = tempdir || PRAGMA('ID')
  365. ADDRESS COMMAND 'MakeDir >NIL: "'tempdir'"'
  366. IF RC ~= 0 THEN
  367.     EXIT RC
  368. tempdir = tempdir || '/'
  369.  
  370. tmpdname = 'T:pprx_dcat.'PRAGMA('ID')
  371. tmpfname = 'T:pprx_cat.'PRAGMA('ID')
  372. tmpfname2 = tmpfname || '.2'
  373.  
  374. IF OPEN('listfile', tmpdname, 'W') THEN DO
  375.     CALL WRITELN('listfile', srcdir)
  376.     CALL CLOSE('listfile')
  377. END
  378. IF recurse THEN
  379.     ADDRESS COMMAND 'List >>'tmpdname' "'srcdir'" NOHEAD LFORMAT="%s%s" DIRS ALL'
  380.  
  381. IF OPEN('dirlistfile', tmpdname, 'R') THEN DO
  382.     cancelled = 0
  383.     DO FOREVER
  384.         srcdir = READLN('dirlistfile')
  385.         IF EOF('dirlistfile') THEN
  386.             LEAVE
  387.  
  388.         IF recurse THEN DO
  389.             dstdir = srcdir
  390.             dir_trail = RIGHT(dstdir, 1)
  391.             IF dir_trail ~= ':' & dir_trail ~= '/' THEN
  392.                 dstdir = dstdir || '/'
  393.         END
  394.  
  395.         IF delete_old THEN DO
  396.             dir_trail = RIGHT(srcdir, 1)
  397.             IF dir_trail ~= ':' & dir_trail ~= '/' THEN
  398.                 deldir = srcdir || '/'
  399.             ELSE
  400.                 deldir = srcdir
  401.             ADDRESS COMMAND 'Delete >NIL: "'deldir || destpattern'"'
  402.             ADDRESS COMMAND 'Delete >NIL: "'deldir || destpattern'.info"'
  403.         END
  404.  
  405.         ADDRESS COMMAND 'List >'tmpfname' "'srcdir'" NOHEAD PAT=~(#?.info) LFORMAT="%s%s" FILES'
  406.         IF RC = 0 THEN DO
  407.             ADDRESS COMMAND 'Sort 'tmpfname tmpfname'.s'
  408.             IF RC = 0 THEN DO
  409.                 ADDRESS COMMAND 'Delete >NIL: 'tmpfname
  410.                 tmpfname = tmpfname'.s'
  411.             END
  412.         END
  413.  
  414.         IF OPEN('listfile', tmpfname, 'R') THEN DO
  415.             errmess = ''
  416.             done = 0
  417.             thmbcolors = ''
  418.             catnum = 1
  419.             DO UNTIL done
  420.                 CALL InitPage
  421.                 DO FOREVER
  422.                     fname = READLN('listfile')
  423.                     IF EOF('listfile') THEN DO
  424.                         done = 1
  425.                         LEAVE
  426.                     END
  427.                     LoadBrush '"'fname'" QUIET FORCE NOPROGRESS'
  428.                     IF RC = 0 THEN DO
  429.                         GetBrushAttributes 'WIDTH'
  430.                         bw = RESULT
  431.                         GetBrushAttributes 'HEIGHT'
  432.                         bh = RESULT
  433.                         GetBrushAttributes 'DPIX'
  434.                         bhdpi = RESULT
  435.                         GetBrushAttributes 'DPIY'
  436.                         bvdpi = RESULT
  437.                         bratio = bhdpi / bvdpi
  438.  
  439.                         brushw = thmbw;
  440.                         brushh = TRUNC(((brushw / (bw / bh)) * bratio) / imgratio)
  441.                         IF brushh > thmbh THEN DO
  442.                             brushh = thmbh;
  443.                             brushw = TRUNC(((brushh / (bh / bw)) / bratio) * imgratio)
  444.                         END
  445.  
  446.                         IF cavrg = 0 THEN
  447.                             SetBrushAttributes 'WIDTH 'brushw' HEIGHT 'brushh' NOPROGRESS'
  448.                         ELSE
  449.                             SetBrushAttributes 'WIDTH 'brushw' HEIGHT 'brushh' COLORS 256 EXTENDPALETTE NOPROGRESS'
  450.                         IF RC = 0 THEN DO
  451.                             IF makepalette THEN DO
  452.                                 BrushColorStatistics 'COLORS COMPACT NOPROGRESS'
  453.                                 IF RC = 0 THEN DO
  454.                                     thcolors = RESULT
  455.                                     IF (LENGTH(thmbcolors) + LENGTH(thcolors)) < 65535 THEN
  456.                                         thmbcolors = thmbcolors thcolors
  457.                                 END
  458.                             END
  459.                             ppos = MAX(LASTPOS(':', fname), LASTPOS('/', fname)) + 1
  460.                             brushname = SUBSTR(fname, ppos)
  461.  
  462.                             SaveBrush '"'tempdir || brushname'" QUIET FORCE NOPROGRESS'
  463.                             IF RC = 0 THEN DO
  464.                                 IF AddTile(0) THEN
  465.                                     LEAVE
  466.                             END
  467.                             ELSE DO
  468.                                 done = 1
  469.                                 errmess = txt_err_resize || RC
  470.                                 LEAVE
  471.                             END
  472.                         END
  473.                     END
  474.                     ELSE DO
  475.                         IF RC ~= 38 THEN DO    /* unrecognized format? */
  476.                             done = 1
  477.                             errmess = txt_err_load || RC
  478.                             LEAVE
  479.                         END
  480.                     END
  481.                 END
  482.  
  483.                 IF errmess ~= '' THEN
  484.                     LEAVE
  485.  
  486.                 IF makepalette THEN DO
  487.                     ReduceColors cnum '"'thmbcolors'"'
  488.                     IF RC ~= 0 THEN DO
  489.                         done = 1
  490.                         IF RC = 5 THEN
  491.                             cancelled = 1
  492.                         ELSE
  493.                             errmess = txt_err_creduc || RC
  494.                         LEAVE
  495.                     END
  496.                 END
  497.                 ELSE RC = 0
  498.  
  499.                 IF RC = 0 THEN DO
  500.                     IF makepalette THEN DO
  501.                         SetColors 'COLORS "'RESULT'"'
  502.                         CALL FindPens
  503.                     END
  504.  
  505.                     tmpfname2 = tmpfname || '.2'
  506.                     ADDRESS COMMAND 'List >'tmpfname2' "'tempdir'" NOHEAD PAT=~(#?.info) LFORMAT="%s%s" FILES'
  507.                     IF RC = 0 THEN DO
  508.                         ADDRESS COMMAND 'Sort 'tmpfname2 tmpfname2'.s'
  509.                         IF RC = 0 THEN DO
  510.                             ADDRESS COMMAND 'Delete >NIL: 'tmpfname2
  511.                             tmpfname2 = tmpfname2'.s'
  512.                         END
  513.                     END
  514.                     IF OPEN('listfile2', tmpfname2, 'R') THEN DO
  515.                         CALL InitPage
  516.  
  517.                         DO FOREVER
  518.                             fname = READLN('listfile2')
  519.                             IF EOF('listfile2') THEN
  520.                                 LEAVE
  521.                             LoadBrush '"'fname'" QUIET FORCE NOPROGRESS'
  522.                             IF RC = 0 THEN DO
  523.                                 GetBrushAttributes 'WIDTH'
  524.                                 brushw = RESULT
  525.                                 GetBrushAttributes 'HEIGHT'
  526.                                 brushh = RESULT
  527.  
  528.                                 RemapBrush 'NOPROGRESS'
  529.                                 IF RC = 0 THEN DO
  530.                                     ppos = MAX(LASTPOS(':', fname), LASTPOS('/', fname)) + 1
  531.                                     brushname = SUBSTR(fname, ppos)
  532.                                     IF AddTile(1) THEN
  533.                                         LEAVE
  534.                                 END
  535.                                 ELSE DO
  536.                                     done = 1
  537.                                     errmess = txt_err_cremap || RC
  538.                                     LEAVE
  539.                                 END
  540.                             END
  541.                             ELSE DO
  542.                                 done = 1
  543.                                 errmess = txt_err_load || RC
  544.                                 LEAVE
  545.                             END
  546.                         END
  547.                         CALL CLOSE('listfile2')
  548.  
  549.                         SaveImage '"'dstdir || CatalogFName(dstfile, catnum)'" FORCE QUIET' dstformat
  550.                         IF RC ~= 0 THEN DO
  551.                             done = 1
  552.                             IF RC = 5 THEN
  553.                                 cancelled = 1
  554.                             ELSE
  555.                                 errmess = txt_err_save || RC
  556.                         END
  557.                         catnum = catnum + 1
  558.                     END
  559.                     ADDRESS COMMAND 'Delete >NIL: 'tmpfname2
  560.                 END
  561.                 ADDRESS COMMAND 'Delete >NIL: "'tempdir'#?" QUIET'
  562.             END
  563.             CALL CLOSE('listfile')
  564.         END
  565.         IF errmess ~= '' THEN DO
  566.             RequestNotify 'PROMPT "'errmess'"'
  567.             LEAVE
  568.         END
  569.         IF cancelled THEN
  570.             LEAVE
  571.     END
  572.     CALL CLOSE('dirlistfile')
  573. END
  574.  
  575. CALL Break_C
  576.  
  577. EXIT 0
  578.  
  579.  
  580.  
  581.  
  582. InitPage:
  583.  
  584.     SetPen 'BACKGROUND 'colbackg
  585.     ClearImage
  586.  
  587.     clmn = 1
  588.     ypos = vgap
  589.     xpos = hgap
  590.  
  591.     RETURN
  592.  
  593.  
  594.  
  595.  
  596. FindPens:
  597.  
  598.     penpass = 0
  599.  
  600.     DO FOREVER
  601.         IF backgr = 0 THEN
  602.             FindColor '"255 255 255"'
  603.         ELSE IF backgr = 1 THEN
  604.             FindColor '"213 213 213"'
  605.         ELSE
  606.             FindColor '"0 0 0"'
  607.         colbackg = RESULT
  608.  
  609.         IF penpass = 0 THEN
  610.             FindColor '"213 213 213"'
  611.         ELSE
  612.             FindColor '"213 213 213" EXCLUDE "'colbackg'"'
  613.         coltile = RESULT
  614.  
  615.         IF backgr = 2 THEN
  616.             FindColor '"255 255 255"'
  617.         ELSE
  618.             FindColor '"0 0 0"'
  619.         coltext = RESULT
  620.  
  621.         FindColor '"0 0 0"'
  622.         colblack = RESULT
  623.         FindColor '"68 68 68"'
  624.         coldark1 = RESULT
  625.         FindColor '"140 140 140"'
  626.         coldark2 = RESULT
  627.         FindColor '"255 255 255"'
  628.         collight1 = colbackg
  629.         FindColor '"240 240 240"'
  630.         collight2 = RESULT
  631.  
  632.         penpass = penpass + 1
  633.         IF penpass > 1 THEN
  634.             LEAVE
  635.         IF collight1 ~= coltile & coldark1 ~= coltile THEN
  636.             LEAVE
  637.     END
  638.  
  639.     RETURN
  640.  
  641.  
  642.  
  643.  
  644. CatalogFName:
  645.     basefname = ARG(1)
  646.     catlgnum  = ARG(2)
  647.     IF ARG() > 2 THEN
  648.         pattern_fname = ARG(3)
  649.     ELSE
  650.         pattern_fname = 0
  651.  
  652.     npos1 = INDEX(basefname, '0')
  653.     IF npos1 = 0 THEN
  654.         RETURN basefname
  655.  
  656.     ndigits = 1
  657.     bfnlen = LENGTH(basefname)
  658.     DO npos = npos1 + 1 TO bfnlen
  659.         IF SUBSTR(basefname, npos, 1) = '0' THEN
  660.             ndigits = ndigits + 1
  661.         ELSE
  662.             LEAVE
  663.     END
  664.     IF pattern_fname THEN
  665.         catgfname = LEFT(basefname, npos1 - 1) || '#?' || SUBSTR(basefname, npos)
  666.     ELSE
  667.         catgfname = LEFT(basefname, npos1 - 1) || RIGHT(catlgnum, ndigits, "0") || SUBSTR(basefname, npos)
  668.  
  669.     RETURN catgfname
  670.  
  671.  
  672.  
  673. AddTile:
  674.     with_brush = ARG(1)
  675.  
  676.     SetPen 'FOREGROUND 'coltile
  677.     DrawRectangle xpos ypos xpos+tilew-1 ypos+tileh-1 'FILL'
  678.  
  679.     xp0 = xpos + htgap + ((thmbw - brushw) % 2)
  680.     yp0 = ypos + vtgap + ((thmbh - brushh) % 2)
  681.  
  682.     IF collight1 ~= coltile & coldark1 ~= coltile THEN DO
  683.         xp1 = xp0 + brushw - 1
  684.         yp1 = yp0 + brushh - 1
  685.         xps1 = xpos + tilew - 1
  686.         yps1 = ypos + tileh - 1
  687.  
  688.         SetPen 'FOREGROUND 'collight1
  689.         DrawRectangle xp0    yp1+1  xp1+1   yp1+1 'FILL'
  690.         DrawRectangle xp1+1  yp1+1  xp1+1   yp0-1 'FILL'
  691.         DrawRectangle xpos    yps1  xpos    ypos  'FILL'
  692.         DrawRectangle xpos    ypos  xps1-1  ypos  'FILL'
  693.         SetPen 'FOREGROUND 'coldark1
  694.         DrawRectangle xp0-1  yp1+1  xp0-1   yp0-1 'FILL'
  695.         DrawRectangle xp0-1  yp0-1  xp1     yp0-1 'FILL'
  696.         DrawRectangle xpos+1  yps1  xps1    yps1  'FILL'
  697.         DrawRectangle xps1    yps1  xps1    ypos  'FILL'
  698.  
  699.         IF collight1 ~= collight2 & coldark1 ~= coldark2 THEN DO
  700.             SetPen 'FOREGROUND 'collight2
  701.             DrawRectangle xp0-1    yp1+2  xp1+2   yp1+2  'FILL'
  702.             DrawRectangle xp1+2    yp1+2  xp1+2   yp0-2  'FILL'
  703.             DrawRectangle xpos+1  yps1-1  xpos+1  ypos+1 'FILL'
  704.             DrawRectangle xpos+1  ypos+1  xps1-2  ypos+1 'FILL'
  705.             SetPen 'FOREGROUND 'coldark2
  706.             DrawRectangle xp0-2    yp1+2  xp0-2   yp0-2  'FILL'
  707.             DrawRectangle xp0-2    yp0-2  xp1+1   yp0-2  'FILL'
  708.             DrawRectangle xpos+2  yps1-1  xps1-1  yps1-1 'FILL'
  709.             DrawRectangle xps1-1  yps1-1  xps1-1  ypos+1 'FILL'
  710.         END
  711.     END
  712.  
  713.     IF with_brush THEN DO
  714.         SetPaintMode 'REPLACE'
  715.         SetBrushHandle 'UPPERLEFT'
  716.         PutBrush xp0 yp0
  717.     END
  718.     ELSE DO
  719.         SetPen 'FOREGROUND 'colblack
  720.         DrawRectangle xp0 yp0 xp0+brushw-1 yp0+brushh-1 'FILL'
  721.     END
  722.  
  723.     textyp = ypos + tileh + txgap
  724.     textx0 = xpos - hgap
  725.     textx1 = xpos + tilew + hgap - 1
  726.     SetPen 'FOREGROUND 'coltext
  727.     VectorText 'TEXT "'brushname'" FONTPATH "'fontpath'" FONTNAME "'fontname'" X0 'textx0' Y0 'textyp' X1 'textx1' Y1' (textyp + fontsize - 1) 'CENTER ANTIALIAS 2 KEEPRATIO KEEPBASELINE'
  728.     IF RC ~= 0 THEN
  729.         Text 'TEXT "'brushname'" FONTPATH "'fontpath'" FONTNAME "'fontname'" FONTSIZE 'fontsize' FONTSTYLE "'fontstyle'" X' (xpos + (tilew % 2)) ' Y 'textyp' CENTER'
  730.  
  731.     last_one = 0
  732.     xpos = xpos + tilew + hgap
  733.     clmn = clmn + 1
  734.     IF clmn > columns THEN DO
  735.         clmn = 1
  736.         xpos = hgap
  737.         totvgap = tileh + txgap + fontsize + (vgap % 3)
  738.         ypos = ypos + totvgap
  739.         IF (ypos + totvgap) > imgheight THEN
  740.             last_one = 1
  741.     END
  742.  
  743.     RETURN last_one
  744.  
  745.  
  746.  
  747.  
  748. SaveSet:
  749.     sname = ARG(1)
  750.     val = ARG(2)
  751.  
  752.     IF OPEN('settingfile', 'ENV:PP_Catal_'sname, 'W') THEN DO
  753.         CALL WRITECH('settingfile', val)
  754.         CALL CLOSE('settingfile')
  755.     END
  756.  
  757.     RETURN
  758.  
  759.  
  760.  
  761.  
  762. LoadSet:
  763.     sname = ARG(1)
  764.     def_val = ARG(2)
  765.     IF ARG() > 2 THEN
  766.         request_quote = ARG(3)
  767.     ELSE
  768.         request_quote = 1
  769.  
  770.     val = def_val
  771.     set_fname = 'ENV:PP_Catal_'sname
  772.  
  773.     IF OPEN('settingfile', set_fname, 'R') THEN DO
  774.         val = READCH('settingfile', 65535)
  775.         CALL CLOSE('settingfile')
  776.     END
  777.  
  778.     IF request_quote THEN DO
  779.         /* encode quotes for the Request command ('"' -> '\""') */
  780.         qpos_start = 1
  781.         DO FOREVER
  782.             qpos = INDEX(val, '"', qpos_start)
  783.             IF qpos = 0 THEN BREAK
  784.             val = INSERT('\"', val, qpos-1)
  785.             qpos_start = qpos + 3
  786.         END
  787.     END
  788.  
  789.     RETURN val
  790.  
  791.  
  792.  
  793.  
  794.  
  795. Break_C:
  796.  
  797.     IF tmpfname ~= '' THEN DO
  798.         ADDRESS COMMAND 'Delete >NIL: "'tempdir'" ALL QUIET'
  799.         ADDRESS COMMAND 'Delete >NIL: 'tmpfname tmpfname2
  800.     END
  801.     IF tmpdname ~= '' THEN
  802.         ADDRESS COMMAND 'Delete >NIL: 'tmpdname
  803.  
  804.     FreeBrush 'FORCE'
  805.     SelectSquareBrush 1
  806.     SetArea areasets
  807.     Set '"GCLIP='saveclip'"'
  808.     UnlockGUI
  809.  
  810.     RETURN 1
  811.